home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tex / mf / inputs / misc / feynmf.mf.old < prev    next >
Text File  |  1995-03-15  |  25KB  |  760 lines
  1. %% 
  2. %% This is file `feynmf.mf', generated 
  3. %% on <1994/6/9> with the docstrip utility (2.2h).
  4. %% 
  5. %% The original source files were:
  6. %% 
  7. %% feynmf.dtx  (with options: `base')
  8. %% 
  9. %% Copyright (C) 1989, 1990, 1992-1994 by Thorsten.Ohl@Physik.TH-Darmstadt.de 
  10. %% 
  11. %% This file is NOT the source for feynmf, because almost all comments 
  12. %% have been stripped from it. It is NOT the preferred form of feynmf 
  13. %% for making modifications to it. 
  14. %% 
  15. %% Therefore you can NOT redistribute and/or modify THIS file. You can 
  16. %% however redistribute the complete source (feynmf.dtx and feynmf.ins) 
  17. %% and/or modify it under the terms of the GNU General Public License as 
  18. %% published by the Free Software Foundation; either version 2, or (at 
  19. %% your option) any later version. 
  20. %% 
  21. %% Feynmf is distributed in the hope that it will be useful, but 
  22. %% WITHOUT ANY WARRANTY; without even the implied warranty of 
  23. %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
  24. %% GNU General Public License for more details. 
  25. %% 
  26. %% You should have received a copy of the GNU General Public License 
  27. %% along with this program; if not, write to the Free Software 
  28. %% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 
  29. %% 
  30. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  31. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  32. %% \CheckSum{425}
  33. %% \CharacterTable
  34. %%  {Upper-case    \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
  35. %%   Lower-case    \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
  36. %%   Digits        \0\1\2\3\4\5\6\7\8\9
  37. %%   Exclamation   \!     Double quote  \"     Hash (number) \#
  38. %%   Dollar        \$     Percent       \%     Ampersand     \&
  39. %%   Acute accent  \'     Left paren    \(     Right paren   \)
  40. %%   Asterisk      \*     Plus          \+     Comma         \,
  41. %%   Minus         \-     Point         \.     Solidus       \/
  42. %%   Colon         \:     Semicolon     \;     Less than     \<
  43. %%   Equals        \=     Greater than  \>     Question mark \?
  44. %%   Commercial at \@     Left bracket  \[     Backslash     \\
  45. %%   Right bracket \]     Circumflex    \^     Underscore    \_
  46. %%   Grave accent  \`     Left brace    \{     Vertical bar  \|
  47. %%   Right brace   \}     Tilde         \~}
  48. %%
  49. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  50. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  51. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  52. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  53. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  54. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  55. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  56. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  57. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  58. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  59. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  60. vardef parse_RCS (suffix RCS) (expr s) =
  61.   save n, c;
  62.   numeric n, RCS[];
  63.   string c;
  64.   RCS[0] := 0;
  65.   for n = 1 upto length (s):
  66.     c := substring (n-1,n) of s;
  67.     exitif ((RCS[0] > 0) and (c = " "));
  68.     if ((c = "0") or (c = "1") or (c = "2")
  69.         or (c = "3") or (c = "4") or (c = "5")
  70.         or (c = "6") or (c = "7") or (c = "8")
  71.         or (c = "9")):
  72.       if RCS[0] = 0:
  73.         RCS[0] := 1;
  74.         RCS[RCS[0]] := 0;
  75.       fi
  76.       RCS[RCS[0]] := 10 * RCS[RCS[0]] + scantokens (c);
  77.     elseif c = ".":
  78.       RCS[0] := RCS[0] + 1;
  79.       RCS[RCS[0]] := 0;
  80.     else:
  81.     fi
  82.   endfor
  83. enddef;
  84. vardef require_RCS_revision expr s =
  85.   numeric n;
  86.   save TeX_rev, mf_rev;
  87.   parse_RCS (TeX_rev, s);
  88.   parse_RCS (mf_rev, "1.5");
  89.   for n = 1 upto min (2, TeX_rev[0], mf_rev[0]):
  90.     if TeX_rev[n] > mf_rev[n]:
  91.       errhelp
  92.         "Your version of `feynmf.sty' is higher that of your `feynmf.mf'.";
  93.       errmessage "feynmf: Metafont macros out of date";
  94.     elseif TeX_rev[n] < mf_rev[n]:
  95.       errhelp
  96.         "Your version of `feynmf.mf' is higher that of your `feynmf.sty'.";
  97.       errmessage "feynmf: LaTeX style out of date";
  98.     fi
  99.     exitif (TeX_rev[n] <> mf_rev[n]);
  100.   endfor
  101. enddef;
  102. mode_setup;
  103. thin#:=1pt#; % dimension of the lines
  104. thick#:=2thin#;
  105. arrow_width#:=3thick#; % arrows
  106. arrow_height#:=2arrow_width#;
  107. curly_len#:=3mm#;
  108. dash_len#:=3mm#; % 'photon' lines
  109. dot_len#:=2mm#; % 'photon' lines
  110. wiggly_len#:=4mm#; % 'photon' lines
  111. wiggly_slope:=60;
  112. shade_black#:=1pt#; % shading
  113. shade_white#:=2shade_black#;
  114. shade_angle:=60;
  115. define_blacker_pixels (thick, thin, shade_black, shade_white,
  116.   dash_len, dot_len, wiggly_len, curly_len,
  117.   arrow_height, arrow_width);
  118. LaTeX_unitlength := mm;
  119. vardef count (text list) =
  120.   forsuffixes $ = list: + 1 endfor
  121. enddef;
  122. vardef getopt (suffix opt) (expr s) =
  123.   numeric opt.first, opt.last, n;
  124.   string opt[], opt[]arg, c;
  125.   boolean argp, escape;
  126.   opt.first := 0;
  127.   opt.last := 0;
  128.   opt[opt.last] := "";
  129.   argp := false;
  130.   escape := false;
  131.   for n = 1 upto length (s):
  132.     c := substring (n-1,n) of s;
  133.     if not escape and (c = ","):
  134.       if substring (n,n+1) of s = ",":
  135.         escape := true;
  136.       else:
  137.         opt.last := opt.last + 1;
  138.         opt[opt.last] := "";
  139.         argp := false;
  140.       fi
  141.     elseif not argp and (c = "="):
  142.       opt[opt.last]arg := "";
  143.       argp := true;
  144.     elseif argp or (c <> " "):
  145.       if argp:
  146.         opt[opt.last]arg := opt[opt.last]arg & c;
  147.       else:
  148.         opt[opt.last] := opt[opt.last] & c;
  149.       fi
  150.       escape := false;
  151.     fi
  152.   endfor
  153. enddef;
  154. def save_picture text t =
  155.  save t; picture t; forsuffixes p=t: p:=nullpicture; endfor
  156. enddef;
  157. def begin_sketch =
  158.  begingroup save_picture currentpicture;
  159.  sketchlevel := sketchlevel+1;
  160. enddef;
  161. def end_sketch =
  162.  sketchlevel := sketchlevel-1;
  163.  sketchpad[sketchlevel] := currentpicture;
  164.  endgroup
  165. enddef;
  166. picture sketchpad[];
  167. sketchlevel := 1;
  168. vardef use_sketch text t =
  169.  addto currentpicture also (sketchpad[sketchlevel] t)
  170. enddef;
  171. vardef shade expr p_arg =
  172.  save x,y,d,p,currentpen; path p; pen currentpen;    % push pen!
  173.  pickup pencircle scaled shade_black;
  174.  p = p_arg rotated - shade_angle;  % calculate enclosing rectangle
  175.  x2' = x3' = xpart directionpoint up of p; % (rotated by |shade_angle|).
  176.  x1' = x4' = xpart directionpoint down of p;
  177.  y1' = y2' = ypart directionpoint right of p;
  178.  y3' = y4' = ypart directionpoint left of p;
  179.  forsuffixes $=1,2,3,4: z$ = z$' rotated shade_angle; endfor
  180.  d = abs(z1-z4); % height.
  181.  begin_sketch % fill rectangle with lines.
  182.   for k=shade_white/d step (shade_white+shade_black)/d
  183.     until 1 - shade_white/d:
  184.    cutdraw k[z1,z4] -- k[z2,z3];
  185.   endfor
  186.   cullit;
  187.   fill p_arg;
  188.   unfill z1--z2--z3--z4--cycle;
  189.   cullit;
  190.  end_sketch;
  191.  use_sketch;
  192. enddef;
  193. vardef arrow =
  194.  clearxy; % push 'em!
  195.  x1 - x2 = arrow_height; y2 - y3 = arrow_width;
  196.  x1 = -3x2; x2 = x3; y1 = y2 + y3 = 0; % center it!
  197.  z1--z2--z3--cycle
  198. enddef;
  199. vardef cut_circles (expr diam_a, p_arg, diam_b) =
  200.  subpath (xpart(p_arg intersectiontimes fullcircle scaled diam_a
  201.           shifted point 0 of p_arg),
  202.       xpart(p_arg intersectiontimes fullcircle scaled diam_b
  203.           shifted point infinity of p_arg))
  204.    of p_arg
  205. enddef;
  206. vardef make_blob (expr z_arg, diameter) =
  207.  save p,currentpen; path p; pen currentpen;
  208.  pickup pencircle scaled thick;
  209.  p = fullcircle scaled diameter shifted z_arg;
  210.  draw p; shade p;
  211. enddef;
  212. vardef draw_blob (expr z_arg, diameter) =
  213.  if sketched_blob_diameter <> diameter: % drawn lately?
  214.   begin_sketch make_blob (origin, diameter); end_sketch; % redo hard work!
  215.   sketched_blob_diameter:= diameter;  % record it
  216.  fi
  217.  use_sketch shifted z_arg; % the easy way ...
  218. enddef;
  219. def force_new_blob = sketched_blob_diameter := -1; enddef;
  220. force_new_blob;                                 % initialize it.
  221. vardef put_on_path (expr o_arg, p_arg) =
  222.  fill o_arg rotated angle direction length(p_arg)/2 of p_arg
  223.         shifted point length(p_arg)/2 of p_arg;
  224.  p_arg
  225. enddef;
  226. vardef pixlen (expr p, n) =
  227.   for k=1 upto length(p): + segment_pixlen (subpath (k-1,k) of p, n) endfor
  228. enddef;
  229. vardef segment_pixlen (expr p, n) =
  230.   for k=1 upto n: + abs (point k/n of p - point (k-1)/n of p) endfor
  231. enddef;
  232. vardef wiggly (expr p_arg) =
  233.  numeric wpp;
  234.  wpp := ceiling (pixlen (p_arg, 10) / (wiggly_len * length(p_arg)));
  235.  for k=0 upto wpp*length(p_arg) - 1:
  236.   point k/wpp of p_arg
  237.        {direction k/wpp of p_arg rotated wiggly_slope} ..
  238.   point (k+.5)/wpp of p_arg
  239.        {direction (k+.5)/wpp of p_arg rotated - wiggly_slope} ..
  240.  endfor
  241.  if cycle p_arg: cycle else: point infinity of p_arg fi
  242. enddef;
  243. vardef curly (expr p_arg) =
  244.  numeric cpp;
  245.  cpp := ceiling (pixlen (p_arg, 10) / (curly_len * length(p_arg)));
  246.  if cycle p_arg:
  247.    for k=0 upto cpp*length(p_arg) - 1:
  248.      point (k+.33)/cpp of p_arg
  249.            {direction (k+.33)/cpp of p_arg rotated 90} ..
  250.      point (k-.33)/cpp of p_arg
  251.            {direction (k-.33)/cpp of p_arg rotated -90} ..
  252.    endfor
  253.    cycle
  254.  else:
  255.    point 0 of p_arg
  256.          {direction 0 of p_arg rotated -90} ..
  257.    for k=1 upto cpp*length(p_arg) - 1:
  258.      point (k+.33)/cpp of p_arg
  259.            {direction (k+.33)/cpp of p_arg rotated 90} ..
  260.      point (k-.33)/cpp of p_arg
  261.            {direction (k-.33)/cpp of p_arg rotated -90} ..
  262.    endfor
  263.    point infinity of p_arg
  264.          {direction infinity of p_arg rotated 90}
  265.  fi
  266. enddef;
  267. vardef fermion expr path_arg = put_on_path (arrow, path_arg) enddef;
  268. vardef photon expr path_arg = wiggly (path_arg) enddef;
  269. vardef gluon expr path_arg = curly (path_arg) enddef;
  270. save vsty_hash;
  271. def style_def suffix s =
  272.   vsty_hash.s := 1;
  273.   expandafter quote vardef scantokens ("draw_" & str s)
  274. enddef;
  275. vardef vsty_exists suffix s =
  276.   known vsty_hash.s
  277. enddef;
  278. vardef valid_style expr s =
  279.   expandafter vsty_exists scantokens (s)
  280. enddef;
  281. style_def phantom expr path_arg = \ enddef;
  282. style_def plain expr p_arg = draw p_arg enddef;
  283. style_def vanilla expr p_arg = draw p_arg enddef;
  284. style_def fermion (expr p_arg) = draw fermion (p_arg) enddef;
  285. style_def quark (expr p_arg) = draw fermion (p_arg) enddef;
  286. style_def electron (expr p_arg) = draw fermion (p_arg) enddef;
  287. style_def photon (expr p_arg) = draw photon (p_arg) enddef;
  288. style_def boson (expr p_arg) = draw photon (p_arg) enddef;
  289. style_def gluon (expr p_arg) = draw gluon (p_arg) enddef;
  290. style_def dashes (expr p_arg) =
  291.  numeric dpp;
  292.  dpp := ceiling (pixlen (p_arg, 10) / (dash_len * length(p_arg)));
  293.  for k=0 upto dpp*length(p_arg) - 1:
  294.   draw point k/dpp of p_arg ..
  295.    point (k+.5)/dpp of p_arg;
  296.  endfor
  297. enddef;
  298. style_def scalar (expr p_arg) =
  299.   draw_dashes (put_on_path (arrow, p_arg))
  300. enddef;
  301. style_def dots (expr p_arg) =
  302.  numeric dpp;
  303.  dpp := ceiling (pixlen (p_arg, 10) / (dot_len * length(p_arg)));
  304.  for k=0 upto dpp*length(p_arg):
  305.   drawdot point k/dpp of p_arg;
  306.  endfor
  307. enddef;
  308. style_def ghost (expr p_arg) =
  309.   draw_dots (put_on_path (arrow, p_arg))
  310. enddef;
  311. style_def double (expr p_arg) =
  312.   begingroup
  313.     pen oldpen;
  314.     oldpen := currentpen;
  315.     pickup oldpen scaled 3; % draw a thick linn
  316.     draw p_arg;
  317.     pickup oldpen;
  318.     cullit; undraw p_arg; cullit; % and remove the stuffing
  319.   endgroup;
  320. enddef;
  321. style_def heavy (expr p_arg) =
  322.   begingroup
  323.     path discard;
  324.     draw_double (p_arg);
  325.     discard = fermion (p_arg);
  326.   endgroup
  327. enddef;
  328. tracingstats:=1;
  329. boolean vtracing;
  330. vtracing := false; % true
  331. def vinit =
  332.   save vhash;
  333.   numeric vlist.first, vlist.last;
  334.   vlist.first := 1;
  335.   vlist.last := 0;
  336.   pair vlist[]loc;
  337.   numeric vlist[]arc.first, vlist[]arc.last, vlist[]arc[],
  338.     vlist[]arc[]tns, vlist[]arc[]lbl.dist;
  339.   string vlist[]name, vlist[]lbl, vlist[]arc[]sty, vlist[]arc[]lsr,
  340.     vlist[]arc[]lbl, vlist[]arc[]lbl.side;
  341.   numeric vlist[]lbl.ang, vlist[]lbl.side, vlist[]blob, vlist[]dot;
  342. enddef;
  343. def vertices =
  344.   vlist.first upto vlist.last
  345. enddef;
  346. def varcs (text i) =
  347.   vlist[i]arc.first upto vlist[i]arc.last
  348. enddef;
  349. vardef venter suffix v =
  350.   if not vexists v:
  351.     vlist.last := vlist.last + 1;
  352.     vhash.v := vlist.last;
  353.     vlist[vhash.v]name := str v;
  354.     vlist[vhash.v]loc := (whatever,whatever);
  355.     vlist[vhash.v]arc.first := 1;
  356.     vlist[vhash.v]arc.last := 0;
  357.     vlist[vhash.v]lbl := "";
  358.     vlist[vhash.v]lbl.ang := whatever;
  359.     vlist[vhash.v]lbl.dist := 3;
  360.     vlist[vhash.v]blob := 0;
  361.     vlist[vhash.v]dot := 0;
  362.   fi
  363. enddef;
  364. vardef vexists suffix v =
  365.   if known vhash.v: true else: false fi
  366. enddef;
  367. vardef vlookup suffix v =
  368.   if vexists v: vhash.v else: 0 fi
  369. enddef;
  370. vardef vloc suffix v =
  371.   vlist[vlookup v]loc
  372. enddef;
  373. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  374. vardef vconnect (expr linesty) (text vl) =
  375.   save from, nfrom, nto, nopt, sty;
  376.   numeric from, nfrom, nto, nopt;
  377.   string sty;
  378.   getopt (opt, linesty);
  379.   sty := opt[opt.first];
  380.   if known opt[opt.first]arg:
  381.     message "feynmf: line styles don't take arguments.  "
  382.              & "Argument `" & opt[opt.first]arg & "' ignored.";
  383.   fi
  384.   opt.first := opt.first + 1;
  385.   forsuffixes to = vl:
  386.     venter to;
  387.     nto := vlookup to;
  388.     if known nfrom:
  389.       vlist[nfrom]arc.last := vlist[nfrom]arc.last + 1;
  390.       vlist[nto]arc.last := vlist[nto]arc.last + 1;
  391.       vlist[nfrom]arc[vlist[nfrom]arc.last] := nto;
  392.       vlist[nto]arc[vlist[nto]arc.last] := nfrom;
  393.       vlist[nfrom]arc[vlist[nfrom]arc.last]tns := 1;
  394.       vlist[nto]arc[vlist[nto]arc.last]tns := 1;
  395.       vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := "s";
  396.       vlist[nfrom]arc[vlist[nfrom]arc.last]lbl := "";
  397.       vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side := "";
  398.       vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist := 3;
  399.       for nopt = opt.first upto opt.last:
  400.         if opt[nopt] = "tension":
  401.           get_argument (opt[nopt], scantokens (opt[nopt]arg),
  402.                         vlist[nfrom]arc[vlist[nfrom]arc.last]tns);
  403.           get_argument (opt[nopt], scantokens (opt[nopt]arg),
  404.                         vlist[nto]arc[vlist[nto]arc.last]tns);
  405.         elseif opt[nopt] = "left":
  406.           vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := "l";
  407.           ignore_argument (opt[nopt], opt[nopt]arg);
  408.         elseif opt[nopt] = "straight":
  409.           vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := "s";
  410.           ignore_argument (opt[nopt], opt[nopt]arg);
  411.         elseif opt[nopt] = "right":
  412.           vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := "r";
  413.           ignore_argument (opt[nopt], opt[nopt]arg);
  414.         elseif opt[nopt] = "label":
  415.           get_argument (opt[nopt], opt[nopt]arg,
  416.                         vlist[nfrom]arc[vlist[nfrom]arc.last]lbl);
  417.         elseif opt[nopt] = "side":
  418.           get_argument (opt[nopt], opt[nopt]arg,
  419.                         vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side);
  420.         elseif opt[nopt] = "dist":
  421.           get_argument (opt[nopt], scantokens (opt[nopt]arg),
  422.                         vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist);
  423.         else:
  424.           ignore_option (opt[nopt], opt[nopt]arg);
  425.         fi
  426.       endfor
  427.       if valid_style sty:
  428.         vlist[nfrom]arc[vlist[nfrom]arc.last]sty := sty;
  429.       else:
  430.         errhelp "feynmf: your linestyle is not recognizable, "
  431.               & "check spelling and reprocess!";
  432.         errmessage "feynmf: line style `" & sty & "' not known, "
  433.                  & "replaced by `vanilla'";
  434.         vlist[nfrom]arc[vlist[nfrom]arc.last]sty := "vanilla";
  435.       fi
  436.       vlist[nto]arc[vlist[nto]arc.last]sty := "";
  437.     fi
  438.     nfrom := nto;
  439.   endfor
  440. enddef;
  441. vardef get_argument (expr opt, arg) (suffix variable) =
  442.   if known arg:
  443.     variable := arg;
  444.   else:
  445.     message "feynmf: option `" & opt & "' needs an argument.  Ignored.";
  446.   fi
  447. enddef;
  448. vardef ignore_argument (expr opt, arg) =
  449.   if known arg:
  450.     message "feynmf: option `" & opt & "' doesn't take an argument.  "
  451.           & "Argument `" & arg & "' ignored.";
  452.   fi
  453. enddef;
  454. vardef ignore_option (expr opt, arg)=
  455.   if known arg:
  456.     message "feynmf: ignoring option " & opt & "=" & arg & ".";
  457.   else:
  458.     message "feynmf: ignoring option " & opt & ".";
  459.   fi
  460. enddef;
  461. vardef vcycle (expr sty) (suffix v) (expr n) =
  462.   for $ = 1 upto n - 1:
  463.     vconnect (sty, v[$], v[$+1]);
  464.   endfor
  465.   vconnect (sty, v[n], v[1]);
  466. enddef;
  467. vardef circle_left (expr a, b) =
  468.   reverse halfcircle
  469.     rotated angle (b - a)
  470.     scaled abs (a - b)
  471.     shifted .5[a, b]
  472. enddef;
  473. vardef vcircle_left (suffix a, b) =
  474.   circle_left (vloc a, vloc b) =
  475. enddef;
  476. vardef circle_right (expr a, b) =
  477.   halfcircle
  478.     rotated angle (a - b)
  479.     scaled abs (a - b)
  480.     shifted .5[a, b]
  481. enddef;
  482. vardef vcircle_right (suffix a, b) =
  483.   circle_right (vloc a, vloc b) =
  484. enddef;
  485. vardef vforce (expr z) (suffix v) =
  486.   venter v;
  487.   vlist[vlookup v]loc := z;
  488. enddef;
  489. vardef vshift (expr z) (text vl) =
  490.   forsuffixes $=vl:
  491.     if vexists $:
  492.       vlist[vlookup $]loc := vlist[vlookup $]loc + z;
  493.     fi
  494.   endfor
  495. enddef;
  496. vardef vlabel (expr s) (suffix v) =
  497.   venter v;
  498.   vlist[vlookup v]lbl := s;
  499. enddef;
  500. vardef vvertex (expr vtxsty) (text vl) =
  501.   save nopt, sty, arg;
  502.   numeric nopt, arg;
  503.   string sty;
  504.   getopt (opt, vtxsty);
  505.   sty := opt[opt.first];
  506.   if known opt[opt.first]arg:
  507.     arg := scantokens (opt[opt.first]arg):
  508.   else:
  509.     arg := .2w;
  510.   fi
  511.   opt.first := opt.first + 1;
  512.   forsuffixes v = vl:
  513.     venter v;
  514.     n := vlookup v;
  515.     if sty = "blob":
  516.       vlist[n]blob := arg;
  517.       vlist[n]dot := 0;
  518.     elseif sty = "dot":
  519.       vlist[n]blob := 0;
  520.       vlist[n]dot := 1;
  521.     fi
  522.     for nopt = opt.first upto opt.last:
  523.       if opt[nopt] = "label":
  524.         get_argument (opt[nopt], opt[nopt]arg, vlist[n]lbl);
  525.       elseif opt[nopt] = "angle":
  526.         get_argument (opt[nopt], scantokens (opt[nopt]arg),
  527.                       vlist[n]lbl.ang);
  528.       elseif opt[nopt] = "dist":
  529.         get_argument (opt[nopt], scantokens (opt[nopt]arg),
  530.                       vlist[n]lbl.dist);
  531.       else:
  532.         ignore_option (opt[nopt], opt[nopt]arg);
  533.       fi
  534.     endfor
  535.   endfor
  536. enddef;
  537. vardef vblob (expr bd) (text vl)=
  538.   forsuffixes $=vl:
  539.     if not vexists $: venter $; fi
  540.     vlist[vlookup $]blob := bd;
  541.     vlist[vlookup $]dot := 0;
  542.  endfor
  543. enddef;
  544. vardef vdot (text vl)=
  545.   forsuffixes $=vl:
  546.     if not vexists $: venter $; fi
  547.     vlist[vlookup $]dot := 1;
  548.     vlist[vlookup $]blob := 0;
  549.  endfor
  550. enddef;
  551. vardef in_gallery = (.1w,0)..(0,.5h)..(.1w,h) enddef;
  552. vardef out_gallery = (.9w,0)..(w,.5h)..(.9w,h) enddef;
  553. vardef surround_gallery =
  554.   superellipse ((w,.5h), (.5w,h), (0,.5h), (.5w,0), .75)
  555. enddef;
  556. vardef vincoming (text vl) = vdistribute (in_gallery, vl) enddef;
  557. vardef voutgoing (text vl) = vdistribute (out_gallery, vl) enddef;
  558. vardef vsurround (text vl) = vdistribute (surround_gallery, vl) enddef;
  559. vardef vdistribute (expr p) (text vl) =
  560.   numeric numv, len, off;
  561.   numv := count (vl);
  562.   if cycle p: numv := numv + 1; fi
  563.   len := length (p);
  564.   if numv = 1:
  565.     vforce (point len/2 of p, vl);
  566.   else:
  567.     off := 0;
  568.     forsuffixes $ = vl:
  569.       vforce (point off of p, $);
  570.       off := off + len/(numv-1);
  571.     endfor
  572.   fi
  573. enddef;
  574. def vmklist (suffix v) (expr n) =
  575.   for $ = 1 upto n-1: v[$], endfor v[n]
  576. enddef;
  577. vardef vincomingn (suffix v) (expr n) =
  578.   vincoming (vmklist (v, n));
  579. enddef;
  580. vardef voutgoingn (suffix v) (expr n) =
  581.   voutgoing (vmklist (v, n));
  582. enddef;
  583. vardef vsurroundn (suffix v) (expr n) =
  584.   vsurround (vmklist (v, n));
  585. enddef;
  586. vardef vdistributen (expr p) (suffix v) (expr n) =
  587.   vdistribute (p, vmklist (v, n))
  588. enddef;
  589. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  590. vardef vposition =
  591.   for i = vertices:
  592.     if unknown vlist[i]loc:
  593.       origin = origin
  594.       for j = varcs (i):
  595.         + vlist[i]arc[j]tns * (vlist[i]loc - vlist[vlist[i]arc[j]]loc)
  596.       endfor;
  597.     fi
  598.   endfor
  599.   if vtracing: vdump; fi
  600. enddef;
  601. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  602. vardef vdraw =
  603.   for i = vertices:
  604.     if not known vlist[i]loc:
  605.       errhelp "Your graph specification was not complete (probably a "
  606.             & "lone vertex).            Check logic and reprocess!";
  607.       errmessage "feynmf: vertex `" & vlist[i]name & "' not determined, "
  608.                & "replaced by `(0,0)'.";
  609.       vlist[i]loc := origin;
  610.     fi
  611.   endfor
  612.   for i = vertices:
  613.     for j = varcs (i):
  614.       if vlist[i]arc[j]sty <> "":
  615.         vdraw_arc (vlist[i]arc[j]sty,
  616.                    cut_circles (vlist[i]blob,
  617.                                 if vlist[i]arc[j]lsr = "l":
  618.                                   circle_left (vlist[i]loc,
  619.                                                vlist[vlist[i]arc[j]]loc)
  620.                                 elseif vlist[i]arc[j]lsr = "s":
  621.                                   vlist[i]loc .. vlist[vlist[i]arc[j]]loc
  622.                                 elseif vlist[i]arc[j]lsr = "r":
  623.                                   circle_right (vlist[i]loc,
  624.                                                 vlist[vlist[i]arc[j]]loc)
  625.                                 fi,
  626.                                 vlist[vlist[i]arc[j]]blob),
  627.                    vlist[i]arc[j]lbl,
  628.                    vlist[i]arc[j]lbl.side,
  629.                    vlist[i]arc[j]lbl.dist);
  630.       fi
  631.     endfor;
  632.     vdraw_vertex_label (vlist[i]loc, vlist[i]lbl,
  633.                         vlist[i]lbl.ang, vlist[i]lbl.dist);
  634.     vdraw_vertex_blob (vlist[i]loc, vlist[i]blob);
  635.   endfor
  636.   begingroup
  637.     save currentpen;
  638.     pen currentpen;
  639.     pickup pencircle scaled 2thick;
  640.     for i = vertices:
  641.       vdraw_vertex_dot (vlist[i]loc, vlist[i]dot);
  642.     endfor
  643.   endgroup;
  644. enddef;
  645. vardef vdraw_arc (expr sty, arc, lbl, side, dist) =
  646.   scantokens ("draw_" & sty) (arc);
  647.   vdraw_arc_label (arc, lbl, side, dist);
  648. enddef;
  649. vardef vdraw_arc_label (expr arc, lbl, side, d) =
  650.   if lbl <> "":
  651.     numeric _a;
  652.     pair _z, _zz, _r;
  653.     _z := point .5 length (arc) of arc;
  654.     _r := direction .5 length (arc) of arc rotated - 90;
  655.     if side = "left":
  656.       _a := angle (-_r);
  657.     elseif side = "right":
  658.       _a := angle (_r);
  659.     else:
  660.       _zz = _z - .5[point 0 of arc, point infinity of arc];
  661.       if ((_zz/length (_zz)) dotprod _r) >= 0:
  662.         _a := angle (_r);
  663.       else:
  664.         _a := angle (-_r);
  665.       fi
  666.     fi
  667.     LaTeX_text (_z + d * thick * dir _a, _a, lbl);
  668.   fi
  669. enddef;
  670. vardef vdraw_vertex_label (expr z, lbl, a, d) =
  671.   if lbl <> "":
  672.     numeric _a;
  673.     if unknown a:
  674.       _a := angle (z - .5(w,h));
  675.     else:
  676.       _a := a;
  677.     fi
  678.     LaTeX_text (z + d * thick * dir _a, _a, lbl);
  679.   fi
  680. enddef;
  681. vardef vdraw_vertex_blob (expr z, blob) =
  682.   if blob > 0:
  683.     draw_blob (z, blob);
  684.   fi
  685. enddef;
  686. vardef vdraw_vertex_dot (expr z, dot) =
  687.   if dot > 0:
  688.     drawdot z;
  689.   fi
  690. enddef;
  691. vardef LaTeX expr text =
  692.   message (":" & jobname & "." & decimal charcode & ":" & text & "%%%")
  693. enddef;
  694. vardef LaTeX_text (expr z, a, txt) =
  695.   LaTeX "\fmfL(" & (decimal (xpart z/LaTeX_unitlength)) & ","
  696.       & (decimal (ypart z/LaTeX_unitlength)) & ","
  697.       & (voctant a) & "){" & txt & "}";
  698. enddef;
  699. vardef voctant expr a =
  700.   voctant_list[floor (a/45 + .5)]
  701. enddef;
  702. string voctant_list[];
  703. voctant_list[-4] := "r";
  704. voctant_list[-3] := "rt";
  705. voctant_list[-2] := "t";
  706. voctant_list[-1] := "lt";
  707. voctant_list[0] := "l";
  708. voctant_list[1] := "lb";
  709. voctant_list[2] := "b";
  710. voctant_list[3] := "rb";
  711. voctant_list[4] := "r";
  712. vardef vdump =
  713.   message ">>>>> Vertices and arcs for diagram #" & decimal charcode
  714.         & " of " & jobname & ".mf:";
  715.   for i = vertices:
  716.     message "> " & vlist[i]name & "=" & decimal_pair (vlist[i]loc)
  717.           & ": #lines="
  718.           & decimal (vlist[i]arc.last - vlist[i]arc.first + 1)
  719.           if vlist[i]blob <> 0:
  720.             & ", blob=" & decimal_ (vlist[i]blob)
  721.           fi
  722.           if vlist[i]dot <> 0:
  723.             & ", dot=" & decimal_ (vlist[i]dot)
  724.           fi
  725.           if vlist[i]lbl <> "":
  726.             & ", lbl=" & vlist[i]lbl
  727.             & ", angle=" & decimal_ (vlist[i]lbl.ang)
  728.             & ", dist=" & decimal_ (vlist[i]lbl.dist)
  729.           fi
  730.           & ".";
  731.   endfor
  732.   for i = vertices:
  733.     for j = varcs (i):
  734.       if vlist[i]arc[j]sty <> "":
  735.         message "> " & vlist[i]name & "*" & vlist[vlist[i]arc[j]]name
  736.                 & ": " & vlist[i]arc[j]sty
  737.                 & ", tns=" & decimal_ (vlist[i]arc[j]tns)
  738.                 & ", lsr=" & vlist[i]arc[j]lsr
  739.                 if vlist[i]arc[j]lbl <> "":
  740.                   & ", lbl=" & vlist[i]arc[j]lbl
  741.                   & ", side=" & vlist[i]arc[j]lbl.side
  742.                   & ", dist=" & decimal_ (vlist[i]arc[j]lbl.dist)
  743.                 fi
  744.                 & ".";
  745.       fi
  746.     endfor
  747.   endfor
  748. enddef;
  749. vardef decimal_ (text n) =
  750.   if known n: decimal n else: "?" fi
  751. enddef;
  752. vardef decimal_pair (text z) =
  753.   "(" & decimal_ (xpart z) & "," & decimal_ (ypart z) & ")"
  754. enddef;
  755. endinput;
  756. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  757. \endinput
  758. %% 
  759. %% End of file `feynmf.mf'.
  760.